home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / n_b_v203.zip / TINPUT2.INC < prev    next >
Text File  |  1996-07-04  |  9KB  |  161 lines
  1. $if 0
  2.     ┌──────────────────────────╖                        PowerBASIC v3.20
  3.  ┌──┤          DASoft          ╟──────────────────────┬──────────────────╖
  4.  │  ├──────────────────────────╢    Copyright 1995    │ DATE: 1995-10-01 ╟─╖
  5.  │  │ FILE NAME   TINPUT2 .INC ║          by          ╘════════════════─ ║ ║
  6.  │  │                          ║  Don Schullian, Jr.                     ║ ║
  7.  │  ╘══════════════════════════╝                                         ║ ║
  8.  │ A license is hereby granted to the holder to use this source code in  ║ ║
  9.  │ any program, commercial or otherwise,  without receiving the express  ║ ║
  10.  │ permission of the copyright holder and without paying any royalties,  ║ ║
  11.  │ as long as this code is not distributed in any compilable format.     ║ ║
  12.  │  IE: source code files, PowerBASIC Unit files, and printed listings   ║ ║
  13.  ╘═╤═════════════════════════════════════════════════════════════════════╝ ║
  14.    │                ....................................                   ║
  15.    ╘═══════════════════════════════════════════════════════════════════════╝
  16. $endif
  17.  
  18. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  19. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  20.  
  21. $if 0
  22.   $CODE SEG "DAS_NB01"
  23.   $EVENT               OFF
  24.   $ERROR     ALL       OFF
  25.   $OPTIMIZE  SIZE
  26.   $OPTION    GOSUB     OFF
  27.   $OPTION    CNTLBREAK OFF
  28.   $OPTION    SIGNED    OFF
  29.   $DEBUG     MAP       OFF
  30.   $DEBUG     PATH      OFF
  31.   $DEBUG     UNIT      OFF
  32.   $COMPILE   UNIT
  33.   $INCLUDE   "\TINPUT.TYP"
  34.  
  35.   DECLARE FUNCTION fHelpLine$    (SEG H$,BYVAL Just%)
  36.   DECLARE FUNCTION fTinput$      (SEG D$,BYVAL T$,SEG E$,BYVAL Hattr?,BYVAL Nattr?)
  37.   DECLARE FUNCTION fASCIIr%      (SEG ANY)
  38.   DECLARE      SUB  QCopyStr2Arr (SEG ANY, SEG ANY)
  39.   '────────────────────────────────────────────────────────────────────────
  40.   '──────────  optional w/ fJustify$ ──────────────────────────────────────
  41.   '────────────────────────────────────────────────────────────────────────
  42.   DECLARE FUNCTION fJustify$     (BYVAL D$, BYVAL Length%, BYVAL Just%)
  43.   DECLARE      SUB  TprintCLEAR  (BYVAL R?,BYVAL C?,BYVAL Cs?,BYVAL V$,BYVAL A?)
  44. $endif
  45.     %UP_key     = &h4800
  46.     %DOWN_key   = &h5000
  47.     %CTRL_HOME  = &h7700
  48.     %CTRL_END   = &h7500
  49.     %ENTER_key  = &h000D
  50.     %ESC_key    = &h001B
  51.     %TAB_key    = &h0009 : %SHIFT_TAB  = &h0F00
  52.     %F01_key    = &h3B00
  53.     %F10_key    = &h4400
  54.     %ALT_X = &h2D00
  55.  
  56. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  57. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  58. $if 0
  59.   PURPOSE: provide multi-field support using arrays and fTinput$
  60.            this file is an .INC file to be modified then included into
  61.            your program
  62.    PARAMS: D$() field data both in and out
  63.            T$() TinputTYPE + Mask$ for each field
  64.            S$   skip-to fields with <TAB> and <SHIFT><TAB>
  65.                 CHR$(Fld1%,Fld5%,Fld7%,Fld10%) etc.
  66.                 if S$ = "" then no skipping
  67.            H$() 1 line help for each field
  68.                 if UBOUND( H$(1) ) = 0 then no help printed
  69.            Fld% INCOMING starting field
  70.                 RETURNED last entered/exited field
  71.   RETURNS: exiting key-press of last field
  72.            %ESC_key or %ALT_X
  73.                  no final checking on mandatory fields
  74.                  it is assumed that the user wishes to forget all the
  75.                  changes made. I query this action with important data
  76.                  just to make sure before chucking it all out the window
  77.            %F10_key
  78.                  final mandatory field check & will not exit if all of
  79.                  them have not been filled
  80.                  is is assumed that the user is feeling good about his/her
  81.                  input session and that the data should be stored/saved
  82.      NOTE: %F01_key
  83.                  is supported for help but you need to place the call
  84.                  command in this code. .Just or .Style could be used to
  85.                  determine which of the help screens to pop for explicit
  86.                  field style sensitive help
  87.      NOTE: if .Just is not being used by any fields and you are not using
  88.            fJustify$ then remove the 2 lines of code that make that call
  89. $endif
  90. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  91. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  92. FUNCTION fTinput2%( SEG D$(), SEG T$(), SEG S$, SEG H$(), SEG Fld% ) LOCAL PUBLIC
  93.   LOCAL Exet$, G%, HelpOn%, Hline$
  94.   LOCAL Last%, TabFlds%, X%, T&, S?()
  95.  
  96.   DIM tINP AS TinputTYPE                                      ' local type
  97.   Last%    = UBOUND( D$(1) )                                  ' last field
  98.   Fld%     = MIN( MAX( 1, Fld% ), Last% )                     ' 1st field
  99.   HelpOn%  = UBOUND( H$(1) )                                  ' use help?
  100.   Exet$    = CHR$(0,45,0,59,0,68,0,72,0,80,0,117,0,119)       ' exit keys
  101.   TabFlds% = LEN(S$)                                          ' # of tab flds
  102.   IF TabFlds% > 0 THEN                                        ' use tab flds?
  103.     DIM S?(TabFlds%)                                          ' local array
  104.     QcopySTR S$, S?(1)                                        ' load array
  105.     Exet$ = CHR$(9,0,0,15) + Exet$                            ' exit keys
  106.   END IF                                                      '
  107.   IF HelpON%  > 0 THEN Hline$ = fHelpLine$( H$(Fld%), 1 )     ' set-up help
  108.   DO                                                          '
  109.     IF HelpOn% > 0 THEN fHelpLine H$(Fld%), 1                 ' print help
  110.     G% = fTinput%( D$(Fld%), T$(Fld%), Exet$, 31, 113 )       ' do it!
  111.     IF G% = %ESC_key OR G% = %ALT_X THEN EXIT LOOP            ' bail out
  112.     IF G% = %F01_key THEN                                     ' Help
  113.       ' PUT HELP CALL HERE                                    '   your rtn
  114.       ITERATE                                                 '   goes here
  115.     END IF                                                    '
  116.     LSET tINP = T$(Fld%)                                      '
  117.     IF tINP.Just > 0 THEN                                     ' if you're not
  118.       D$(Fld%) = fJustify$( D$(Fld%), tINP.Cols, tINP.Just )  ' using this
  119.       TprintCLEAR tINP.Row, tINP.Col, tINP.Cols, D$(Fld%), 0  ' then delete
  120.       IF ( tINP.MustBe > 0  )  AND _                          ' final test
  121.          ( D$(Fld%)    = "" ) THEN ITERATE                    ' final test?
  122.     END IF                                                    '
  123.     SELECT CASE G%                                      '''''''''''''''''''''
  124.       CASE %UP_key                                      '
  125.            DECR Fld%, 1                                 '
  126.            IF Fld% = 0 THEN Fld% = Last%                '   prev field
  127.       CASE %DOWN_key, %ENTER_key                        '
  128.            INCR Fld%, 1                                 '
  129.            IF Fld% > Last% THEN Fld% = 1                '   next field
  130.       CASE %TAB_key                                     '
  131.            S?(0) = S?(1)                                '
  132.            ARRAY SCAN S?(1) FOR TabFlds%, > Fld%, TO X% '
  133.            Fld% = S?(X%)                                '
  134.       CASE %SHIFT_TAB                                   '
  135.            S?(0) = S?(TabFlds%)                         '
  136.            FOR X% = TabFlds% TO 1 STEP -1               '   search S?() for
  137.              IF Fld% > S?(X%) THEN EXIT FOR             '   previous skip
  138.            NEXT                                         '   field
  139.            Fld% = S?(X%)                                '
  140.       CASE %CTRL_HOME                                   '
  141.            Fld% = 1                                     '
  142.       CASE %CTRL_END                                    '
  143.            Fld% = Last%                                 '
  144.       CASE %F10_key                                     '
  145.            FOR G% = Last% TO 1 STEP -1                  ' run a last check
  146.              LSET tINP = T$(G%)                         ' on mandi